open Base

module type CORE = sig
  type ctx
  type spine
  val in_container: spine -> ctx -> ctx

  type ('s, 'e) atom
  val init_atom
    :  cb:('e -> unit)
    -> ctx:ctx
    -> ('s, 'e) atom
    -> ('s -> unit) Staged.t
end

module Make_components(C: CORE) : sig
  type ctx          = C.ctx
  type spine        = C.spine
  type ('a,'e) atom = ('a,'e) C.atom

  type +'e t
  (** component type *)

  val atom : init:'s -> ('s, 'e) atom -> 'e t
  (** create component from atom *)

  val container : s:spine -> 'e t list -> 'e t
  (** create component from container *)

  val mount : ctx -> 'e t -> unit
  (** mount component in context *)

end = struct
  type ctx = C.ctx
  type spine = C.spine
  type ('a,'e) atom = ('a,'e) C.atom

  type +_ t = T: 'a node * ('a -> 'b) -> 'b t
  and _ node =
    | Atom: ('s, 'e) C.atom * 's -> 'e node
    | Container: C.spine * 'e t list -> 'e node

  (* constructors *)

  let atom ~init atm = T(Atom(atm, init), Fn.id)
  let container ~s ts = T(Container(s, ts), Fn.id)

  (* mounting *)

  let rec mount : 'e. ctx -> 'e t -> unit =
    fun ctx (T(node, _)) ->
    mount_node ctx node

  and mount_node : 'e. ctx -> 'e node -> unit =
    fun ctx -> function
    | Container(spine, ts) ->
       let ctx = C.in_container spine ctx in
       List.iter ~f:(mount ctx) ts
    | Atom(atm, init) ->
       let cb = ignore in
       let push_update =
         Staged.unstage
           (C.init_atom ~cb ~ctx atm)
       in
       push_update init

end
